package Maya;
use base qw(Class::Accessor::Fast);

use strict;
use warnings;

use App::Cache;
use Archive::Extract;
use File::Basename qw(basename);
use File::chdir;
use File::Copy;
use File::Find::Rule;
use File::Slurp;
use File::Temp qw/ tempdir /;
use Maya::Distribution;
use Maya::Package;
use List::MoreUtils qw(firstval);
use LWP::Simple;
use Module::CoreList;
use Module::Depends::Intrusive;
use Parse::CPAN::Packages;
use Path::Class;
use Template;
use version;
use List::MoreUtils qw( uniq );
use Data::Dumper;

$Archive::Extract::PREFER_BIN = 1;

$ENV{PERL_AUTOINSTALL} = '--skipdeps';

__PACKAGE__->mk_accessors(qw( cache workdir ));

=head2 new

    $maya = Maya->new( \%args );

Create a new maya object. Does some initial initialization such as creating
the cache.

=cut

sub new {
    my $class = shift;
    my $self  = $class->SUPER::new(shift);
    $self->cache( App::Cache->new( { ttl => 60 * 60 } ) );

    # create a working directory
    $self->workdir( dir( tempdir() ) );

    return $self;
}

sub DESTROY {
    my $self = shift;

    my $workdir = $self->workdir;
    $workdir->rmtree;
}

# get the version of perl in Debian
my $perl_version
    = '5.008008';    # FIXME - should probably work this out somehow.

# version->new( __PACKAGE__->version_in_debian('perl') )->numify;

$| = 1;

our $DETAILS_FILENAME = "02packages.details.txt.gz";

our $LOCAL_CPAN         = dir('local_cpan')->absolute;
our $LOCAL_CPAN_DETAILS = $LOCAL_CPAN . "/modules/" . $DETAILS_FILENAME;

our $REAL_CPAN         = 'http://www.cpan.org/';
our $REAL_CPAN_DETAILS = $REAL_CPAN . "/modules/" . $DETAILS_FILENAME;

our $REPOSITORY = dir('/var/www/debian/test')->absolute;

# We're not going to build these as debian versions are good enough!
my $use_debian = {
    'perlmagick' => 'perlmagick',
    'mod_perl'   => 'libapache-mod-perl',
    'libapreq'   => 'libapache-request-perl',
};

# any non perl dependencies
my $additional_debian_dependencies = {
    'file-rsync'        => ['rsync'],
    'crypt-ssleay'      => ['libssl-dev'],
    'dbd-mysql'         => ['libmysqlclient15-dev'],
    'gd'                => ['libgd2-noxpm-dev'],
    'cairo'             => ['cairo2-maya'],
    'image-imlib2'      => ['libimlib2-dev'],
    'term-caca'         => ['libcaca-dev'],
    'text-aspell'       => [ 'libaspell-dev', 'aspell-en', 'aspell' ],
    'term-readline-gnu' => ['libreadline5-dev'],
    'xml-libxml'        => ['libxml2-dev'],
    'xml-parser'        => ['libexpat1-dev'],
    'cache-memcached'   => ['memcached'],
};

# If the package author forgot them!
my $additional_dependencies = {
    'dbd-mysql'  => ['DBI'],
    'dbix-class' => ['Module::Find'],
    'xml-libxml' => ['XML::LibXML::Common'],
};

# Little hacks to fix/clean before installing
my $post_extract_code = {
    'xml-sax' =>
        sub { system "perl -pi -e 's{MY::install}{OFF}' Makefile.PL" },
    'xml-libxml' =>
        sub { system "perl -pi -e 's{MY::install}{OFF}' Makefile.PL" },
    'file-rsync' =>
        sub { system q[perl -pi -e 's{<STDIN>}{"/usr/bin/rsync"}' makepm.PL] }
    ,
    'template-toolkit' => sub { unlink "t/dbi.t" },
    'dbd-csv' =>
        sub { system q[perl -pi -e 's{DBD::File}{DBI}' Makefile.PL] },
    'math-geometry-planar-offset' => sub {
        system
            q[perl -pi -e 's{Math::Geometry::Planar => .1.14.,}{}' Makefile.PL];
    },
};

# Extra make options
my $perl_makefile_pl
    = { 'template-toolkit' =>
        '$(PERL) Makefile.PL TT_DOCS=n TT_SPLASH=n TT_EXAMPLES=n TT_EXTRAS=n TT_ACCEPT=y INSTALLDIRS=site',
    };

# Skip the tests
my $skip_tests = {
    map { $_ => 1 } (
        'apache-test',    'dbd-mysql',
        'email-valid',    'graphics-colornames',
        'ipc-run',        'json-xs',
        'libterm-getkey', 'mogilefs-server',
        'netaddr-ip',     'number-format',
        'soap-lite',      'test-file',
        'text-aspell',    'xml-simple',
        'module-build',   'datetime-format-strptime',
    )
};

# where we've merged modules, we add them here so we can Provide and Conflict
my $package_supercedes = {};

=head2 local_packages

    $local_packages = $self->local_packages();

Returns the (possibly cached) Parse::CPAN::Packages object from the in-house
CPAN server. This is fetched each time, but is cached for the lifetime of the
process.

=cut

my $CACHED_PACKAGES;

sub local_packages {
    my $self = shift;

    return $CACHED_PACKAGES if $CACHED_PACKAGES;

    $CACHED_PACKAGES = Parse::CPAN::Packages->new($LOCAL_CPAN_DETAILS);

    return $CACHED_PACKAGES;
}

=head2 real_packages

    $real_packages = $self->real_packages();

Returns the (possibly cached) Parse::CPAN::Packages object from a real CPAN
server.

=cut

my $CACHED_REAL_PACKAGES;

sub real_packages {
    my $self = shift;

    return $CACHED_REAL_PACKAGES ||= Parse::CPAN::Packages->new(
        $self->cache->get_url($REAL_CPAN_DETAILS) );
}

my $CACHED_OUR_MODULES = undef;



sub build {
    my ( $self, $package, $version ) = @_;
    $version ||= 0;

    die "No package passed!" unless $package;

    print "\n\n ** Trying to build $package $version **\n\n";

    # no need to build if this version is in the core
    my $version_in_core = $Module::CoreList::version{$perl_version}{$package};
    if ( defined $version_in_core
        && $self->version_good_enough( $version_in_core, $version ) )
    {
        print "$package $version_in_core is in the core\n";
        return;
    }

    # load this module from a variety of sources
    my $m;
 	if ( -f $package ) {
        warn("Using: _package_from_file\n");
        $m       = $self->_package_from_file($package);
        $version = $m->version;

    } else {
        warn("Using: _package_from_local_cpan\n");
        $m = $self->_package_from_local_cpan($package);
    }
    return unless $m;

    my $d    = $m->distribution();
    my $dist = $d->dist;

    print "Distribution is $dist\n";

    return if $dist eq 'Module-Install';

    if ( my $debian_name = $use_debian->{ lc $dist } ) {
        warn("$dist found in use_debian. Using: install_deb($debian_name)\n");
        $self->install_deb($debian_name);
        print "using $debian_name\n";
        return $debian_name;
    }

    my $debian_name = 'lib' . lc($dist) . '-perlmaya';
    $debian_name =~ s/_/-/g;

    my $in_maya = $self->in_debian( $debian_name, $package, $version, $dist,
        $d->version );
    if ($in_maya) {
        print "Using version from maya: $in_maya\n";
        return $in_maya;
    }

    my $version_on_cpan = $m->version;
    unless ( $self->version_good_enough( $version_on_cpan, $version ) ) {
        my $version_in_debian = $self->version_in_debian($debian_name);
        if ( $self->version_good_enough( $version_in_debian, $version ) ) {
            return $debian_name;
        } else {

            # We can't find this version on our local CPAN - see if we could
            # get it off the real CPAN.
            my $real_cpan_m
                = eval { $self->_package_from_real_cpan($package) };

            my $real_cpan_m_version
                = $real_cpan_m
                ? $real_cpan_m->version
                : 0;

            my $msg
                = "We want $package $version but local CPAN only has $version_on_cpan!";
            $msg
                .= " ( real CPAN has version $real_cpan_m_version - perhaps it should be copied over?)";

            die $msg;
        }
    }

    my $filename = $d->filename;
    $filename =~ s{^.+/}{};
	unless ( -f $filename ) {
            my $local_cpan_path = "$LOCAL_CPAN/authors/id/" . $d->prefix;
            print "Copying $local_cpan_path to $filename\n";
            copy( $local_cpan_path, $filename );
        }
    

    die "Failed to fetch $filename!" unless -f $filename;

    my $tmp = dir( $d->distvname );
    $tmp->rmtree;
    $tmp->mkpath;

    my $ae = Archive::Extract->new( archive => $filename );
    unless ( $ae->extract ) {
        die "Failed to extract: " . $ae->error;
    }

    my $extract_path = $ae->extract_path;

    #    print "Extracted to " . $extract_path . "\n";

    if ( my $code = $post_extract_code->{ lc $dist } ) {
        local $CWD = $extract_path;
        $code->();
    }

    my $module_depends;

    my $makefile_pl;
    eval {
        $makefile_pl
            = read_file( file( $extract_path, 'Makefile.PL' )->stringify );
    };

    if ( $makefile_pl =~ /Module::Install/ ) {
        $module_depends = Module::Depends->new;
    } else {
        $module_depends = Module::Depends::Intrusive->new;
    }

    my $deps = $module_depends->dist_dir($extract_path)->find_modules;

    my %deps
        = ( %{ $deps->build_requires || {} }, %{ $deps->requires || {} } );
    my @additional_debian_dependencies
        = @{ $additional_debian_dependencies->{ lc $dist } || [] };
    foreach my $d (@additional_debian_dependencies) {
        $self->install_deb($d);
    }

    my $deb_txt = file( $extract_path, 'DEB.txt' )->stringify;
    my $deb_prereqs = '';
    if ( -f $deb_txt ) {
        my @prereqs = read_file($deb_txt);
        chomp @prereqs;
        $deb_prereqs = join ",\n ", '', @prereqs;
    }

    foreach my $d ( @{ $additional_dependencies->{ lc $dist } || [] } ) {
        $deps{$d} = '0';
    }

    my @deps;
    foreach my $dep ( keys %deps ) {
        next if $dep eq 'perl';     # quite frankly, our perl is good enough
        next if $dep eq 'Config';
        push @deps, $self->build( $dep, $deps{$dep} );
    }

    push @deps, @additional_debian_dependencies;

    my $debian_path = dir( $extract_path, 'debian' );
    $debian_path->mkpath;

    my $module_build = 0;
    if ( -e file( $extract_path, 'Build.PL' ) ) {
        if ( $dist ne 'Module-Build' ) {
            push @deps, $self->build('Module::Build');
        }
        $module_build = 1;
    }

    # kludge Class::MethodMaker to use Makefile.PL
    $module_build = 0 if $dist eq 'Class-MethodMaker';

    my $vars = {
        debian_name      => $debian_name,
        d                => $d,
        deps             => \@deps,
        deb_prereqs      => $deb_prereqs,
        module_build     => $module_build,
        perl_makefile_pl => $perl_makefile_pl->{ lc $dist },
        skip_tests       => $skip_tests->{ lc $dist },
        supercedes       => $package_supercedes->{$debian_name},
    };

    my $template = Template->new;

    $template->process( \$self->changelog, $vars,
        file( $debian_path, 'changelog' )->stringify )
        || die $template->error;
    $template->process( \$self->control, $vars,
        file( $debian_path, 'control' )->stringify )
        || die $template->error;
    $template->process( \$self->rules, $vars,
        file( $debian_path, 'rules' )->stringify )
        || die $template->error;
    chmod 0755, file( $debian_path, 'rules' );
    dir( $debian_path, 'tmp' )->mkpath;

    print "Now let's build the package for $dist\n";
    system "cd $extract_path && dpkg-buildpackage -b -us -uc -rfakeroot";

    my $deb = $debian_name . '_' . $d->version . '-1_all.deb';
    die "Did not find $deb" unless -f $deb;

    $self->add_deb_to_repository($deb);
    $self->install_deb($debian_name);

    warn "* have built DEB for $debian_name (@deps)";

    return $debian_name;
}


sub _package_from_file {
    my ( $self, $package ) = @_;

    my $filename = $package;
    $package =~ s/\.tar\.gz$//;
    my $version;
    ( $version, $package )
        = map { scalar reverse $_ } split( "-", reverse($package), 2 );
    my $dist = $package;
    $package =~ s/-/::/g;
    my $distribution = Maya::Distribution->new(
        {   dist      => $dist,
            filename  => $filename,
            version   => $version,
            distvname => "$dist-$version",
            prefix    => "NOPREFIX",
        }
    );
    return Maya::Package->new(
        { distribution => $distribution, version => $version } );
}

sub _package_from_local_cpan {
    my ( $self, $package ) = @_;

    my $m = $self->local_packages->package($package);
    die "Did not find $package in CPAN" unless $m;
    return $m;
}

sub _package_from_real_cpan {
    my ( $self, $package ) = @_;

    my $m = $self->real_packages->package($package);
    die "Did not find $package in real CPAN" unless $m;
    return $m;
}

sub add_deb_to_repository {
    my ( $self, $deb ) = @_;
    copy( $deb, "$REPOSITORY/binary" )
        || die "Error copying $deb -> $REPOSITORY: $!";

    system
        "cd $REPOSITORY && dpkg-scanpackages binary /dev/null | gzip -9c > binary/Packages.gz";
    system "sudo apt-get update";
}

sub in_debian {
    my ( $self, $debian_name, $package, $version, $dist, $distversion ) = @_;

    # fake the Debian packages being good enough
    return $debian_name if $dist =~ /^PerlMagick$/;

    my $dist_version_in_debian = $self->version_in_debian($debian_name);
    unless ($dist_version_in_debian) {
        print "$dist $version is not in Debian as $debian_name\n";
        return;
    }

# warn "$self, $debian_name, $package, $version, $dist, $distversion / $dist_version_in_debian";

    my $packages = $self->local_packages;

    #warn "$debian_name $dist $dist_version_in_debian";
    # let's see if we can figure out the package version from the CPAN index
    my $cpan_dist = firstval {
        ( $_->dist && $_->dist eq $dist )
            && ( $_->version && $_->version eq $dist_version_in_debian );
    }
    $packages->distributions;

    my $debian_package_version;    # version of the package within the dist
    if ($cpan_dist) {
        my $distvname    = $cpan_dist->distvname;
        my $cpan_package = firstval {
            ( $_->package eq $package )
                && $_->distribution->distvname eq $distvname;
        }
        $packages->packages;
        $debian_package_version = $cpan_package ? $cpan_package->version : 0;
    }

    unless ( defined $debian_package_version ) {
        print
            "can't determine the CPAN version of $package for $debian_name, assuming it's $dist_version_in_debian\n";
        $debian_package_version = $dist_version_in_debian;
    }

    if ( $self->version_good_enough( $debian_package_version, $version ) ) {
        print
            "$package is already in Debian as $debian_name ($debian_package_version)\n";
        $self->install_deb($debian_name);
        return $debian_name;
    } else {
        print
            "$dist $version is in Debian as $debian_name but only as $debian_package_version\n";
        return;
    }
}

sub version_good_enough {
    my ( $self, $have, $want ) = @_;
    $have = version->new($have);
    $want = version->new($want);
    return $have >= $want;
}

# is_in_debian being a good name for a test, but a bad name to find out what
# version it is
*is_in_debian = \&version_in_debian;

sub version_in_debian {
    my ( $self, $debian_name ) = @_;

    my $out = qx{apt-cache show --no-all-versions $debian_name};
    return unless $out =~ /$debian_name/;
    my ($version) = $out =~ /Version: (.+?)$/ms;
    return unless $version;
    $version =~ s/^.+://;
    $version =~ s/-.+$//;
    return $version;
}

sub install_deb {
    my ( $self, $debian_name ) = @_;

    my $out = qx[dpkg -s $debian_name];
    if ( $out =~ /Status: install ok installed/ ) {
        my ($version) = $out =~ /^Version: (.+)$/m;
        if ( $debian_name =~ /$version/ ) {

            # this version is installed, so do nothing
            return;
        }
    }
    system "sudo apt-get install -y --allow-unauthenticated $debian_name";
    $out = qx[dpkg -s $debian_name];
    if ( $out =~ /Status: install ok installed/ ) {

        # installed
        return;
    } else {
        die "Failed to install $debian_name";
    }
}

sub changelog {
    return q{[% debian_name %] ([% d.version %]-1) unstable; urgency=low

  * Automatic by Maya.

 -- Hinu Systems <accounts@hinuhinu.com>  Fri,  3 Feb 2009 15:09:53 +0000
};
}

sub control {
    return q{Source: [% debian_name %]
Section: perl
Priority: optional
Build-Depends: debhelper (>= 4.0.2)
Build-Depends-Indep: perl (>= 5.8.0-7)
Maintainer: Hinu Systems <accounts@hinuhinu.com>
Standards-Version: 3.6.1
[% IF supercedes.size %]Provides: [% supercedes.join(', ') %][% END %]
[% IF supercedes.size %]Conflicts: [% supercedes.join(', ') %][% END %]


Package: [% debian_name %]
Architecture: all
Depends: perl (>= 5.8.8-7)[% IF deps.size %], [% deps.join(', ') %][% END %][% deb_prereqs %]
Description:  [% d.dist %]
}
}

sub rules {
    return q{#!/usr/bin/make -f
# This debian/rules file is provided as a template for normal perl
# packages. It was created by Marc Brockschmidt <marc@dch-faq.de> for
# the Debian Perl Group (http://pkg-perl.alioth.debian.org/) but may
# be used freely wherever it is useful.
#
# It was later modified by Jason Kohles <email@jasonkohles.com>
# http://www.jasonkohles.com/ to support Module::Build installed modules

# Uncomment this to turn on verbose mode.
#export DH_VERBOSE=1

# If set to a true value then MakeMaker's prompt function will
# always return the default without waiting for user input.
export PERL_MM_USE_DEFAULT=1

PACKAGE=$(shell dh_listpackages)

ifndef PERL
PERL = /usr/bin/perl
endif

#TMP     =$(CURDIR)/debian/$(PACKAGE)
TMP     =$(CURDIR)/debian/tmp

build: build-stamp
build-stamp:
	dh_testdir

	# Add commands to compile the package here
[% IF module_build %]
	$(PERL) -Ilib Build.PL installdirs=site
	OPTIMIZE="-Wall -O2 -g" $(PERL) Build
[% ELSE %]
	[% IF perl_makefile_pl %][% perl_makefile_pl %][% ELSE %]$(PERL) Makefile.PL INSTALLDIRS=site[% END %]
	$(MAKE) OPTIMIZE="-Wall -O2 -g"
[% END %]

	touch build-stamp

clean:
	dh_testdir
	dh_testroot

	# Add commands to clean up after the build process here
[% IF module_build %]
	[ ! -f Build ] || -$(PERL) -Ilib Build distclean
[% ELSE %]
	[ ! -f Makefile ] || $(MAKE) realclean
[% END %]

	dh_clean build-stamp install-stamp

install: build install-stamp
install-stamp:
	dh_testdir
	dh_testroot
	dh_clean -k

	# Add commands to install the package into debian/$PACKAGE_NAME here
[% IF module_build %]
[% UNLESS skip_tests %]
	$(PERL) -Ilib Build test
[% END %]
	$(PERL) -Ilib Build install destdir=$(TMP)
[% ELSE %]
[% UNLESS skip_tests %]
	make test
[% END %]
	$(MAKE) install DESTDIR=$(TMP) PREFIX=/usr/
	rm $(TMP)/usr/local/lib/perl/5.8.*/perllocal.pod
	# [ ! -f $(TMP)/usr/lib/perl/5.8/perllocal.pod ] || rm $(TMP)/usr/lib/perl/5.8/perllocal.pod
	[ ! -d  $(TMP)/usr/bin/ ] || echo "There is a /usr/bin, we must move it to /usr/local/bin"
	[ ! -d  $(TMP)/usr/bin/ ] || mv $(TMP)/usr/bin $(TMP)/usr/local/bin/
#	rmdir --ignore-fail-on-non-empty --parents $(TMP)/usr/lib/perl5
[% END %]
	find $(TMP) -name ".packlist" -exec rm {} \;

	touch install-stamp

binary-arch:
# We have nothing to do by default.

binary-indep: build install
	dh_testdir
	dh_testroot
#	dh_installcron
#	dh_installmenu
#	dh_installexamples
	dh_installdocs
	dh_installchangelogs
	dh_perl
	dh_link
	dh_strip
	dh_compress
	dh_fixperms
	dh_installdeb
	dh_gencontrol
	dh_md5sums
	dh_builddeb

source diff:                                                                  
	@echo >&2 'source and diff are obsolete - use dpkg-source -b'; false

binary: binary-indep binary-arch
.PHONY: build clean binary-indep binary-arch binary
}
}

1;

__END__

=head1 NAME

Maya - Generate Debian packages of CPAN modules

=head1 DESCRIPTION

This module generates Debian packages for CPAN modules and some necessary
dependencies. It installs -perlmaya packages which use the system perl but
can coexist with Debian-shipped packages. 

=head1 AUTHOR

Leon Brocard
Richard Clamp
Leo Lapworth
Edmund von der Burg

=head1 COPYRIGHT

(c) 2008 Leo Lapworth

This library is free software, you can use it under the same terms as perl itself.
This software code is made available "AS IS" without warranties of any kind.

=head1 THANKS

Thanks to Foxtons.co.uk for allowing this to be released.

